home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / LOADBMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  1.9 KB  |  87 lines
  1. { loadbmp.pas -- Load and display a bitmap resource }
  2.  
  3. program LoadBmp;
  4.  
  5. {$R loadbmp.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects;
  8.  
  9. const
  10.  
  11.   id_FaceBmp = 'FACE';
  12.  
  13. type
  14.  
  15.   LBmpApplication = object(TApplication)
  16.     procedure InitMainWindow; virtual;
  17.   end;
  18.  
  19.   PLBmpWindow = ^LBmpWindow;
  20.   LBmpWindow = object(TWindow)
  21.     HFaceBmp: HBitmap;  { Handle to the face bitmap }
  22.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  23.     destructor Done;
  24.       virtual;
  25.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  26.       virtual;
  27.   end;
  28.  
  29.  
  30. { LBmpApplication }
  31.  
  32. {- Initialize LBmpApplication object's window }
  33. procedure LBmpApplication.InitMainWindow;
  34. begin
  35.   MainWindow := New(PLBmpWindow, Init(nil, 'Load Bitmap'))
  36. end;
  37.  
  38.  
  39. { LBmpWindow }
  40.  
  41. {- Construct LBmpWindow object }
  42. constructor LBmpWindow.Init(AParent: PWindowsObject;
  43.   ATitle: PChar);
  44. begin
  45.   TWindow.Init(AParent, ATitle);
  46.   HFaceBmp := LoadBitmap(HInstance, id_FaceBmp)
  47. end;
  48.  
  49. {- Destroy LBmpWindow object }
  50. destructor LBmpWindow.Done;
  51. begin
  52.   DeleteObject(HFaceBmp);
  53.   TWindow.Done
  54. end;
  55.  
  56. {- Paint bitmap in application window }
  57. procedure LBmpWindow.Paint(PaintDC: HDC;
  58.   var PaintInfo: TPaintStruct);
  59. var
  60.   OldBitmap: HBitmap;
  61.   MemDC: HDC;
  62. begin
  63.   MemDC := CreateCompatibleDC(PaintDC);
  64.   OldBitmap := SelectObject(MemDC, HFaceBmp);
  65.   BitBlt(PaintDC, 10, 10, 82, 82, MemDC, 0, 0, srcCopy);
  66.   StretchBlt(PaintDC, 100, 10, 164, 164, MemDC,
  67.     0, 0, 72, 72, srcCopy);
  68.   SelectObject(MemDC, OldBitmap);
  69.   DeleteDC(MemDC)
  70. end;
  71.  
  72. var
  73.  
  74.   LBmpApp: LBmpApplication;
  75.  
  76. begin
  77.   LBmpApp.Init('LBmpApp');
  78.   LBmpApp.Run;
  79.   LBmpApp.Done
  80. end.
  81.  
  82.  
  83. {--------------------------------------------------------------
  84.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  85.   Revision 1.00    Date: 2/15/1991
  86. ---------------------------------------------------------------}
  87.